home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / LIBRARY / PASCALL / VIDEO / FRGB.PAS < prev    next >
Pascal/Delphi Source File  |  1993-06-15  |  5KB  |  190 lines
  1. unit FRgb;
  2. interface
  3. uses
  4.    Objects;
  5. const
  6.    Top                                             =     63;
  7.    FROon                                           =     63;
  8.    FRGon                                           =     15;
  9.    FRNon                                           =     0;
  10.  
  11.    FRCycTop                                        =     FROon;
  12.    FRCycBot                                        =     FRNon;
  13. type
  14.    RFRRgb=record
  15.       Red                                          ,
  16.       Green                                        ,
  17.       Blue                                         :     Byte;
  18.    end;
  19.  
  20.    PFRPal=^TFRPal;
  21.    TFRPal=object(TObject)
  22.       Spot                                         ,
  23.       Red                                          ,
  24.       Green                                        ,
  25.       Blue                                         :     Byte;
  26.     constructor Init(n:Byte);
  27.       procedure Copy;                                    virtual;
  28.       procedure Push;                                    virtual;
  29.       procedure This(a,b,c:Byte);                        virtual;
  30.       procedure That(var a,b,c:Byte);                    virtual;
  31.    end;
  32.    PFRPla=^TFRPla;
  33.    TFRPla=object(TFRPal)
  34.       cRed                                         ,
  35.       cGreen                                       ,
  36.       cBlue                                        :     Integer;
  37.     constructor Init(n:Byte);
  38.       procedure Cycle;                                   virtual;
  39.    end;
  40.  
  41.    AFRPalette=array [0..255] of TFRPal;
  42.    AFRPlaette=array [0..255] of TFRPla;
  43.  
  44.    PFRPalette=^TFRPalette;
  45.    TFRPalette=object(TObject)
  46.       Pals                                         :     AFRPalette;
  47.     constructor Init;
  48.       procedure Copy;                                    virtual;
  49.       procedure Push;                                    virtual;
  50.       procedure ThisAt(a,b,c,d:Byte);                    virtual;
  51.       procedure ThatAt(var a,b,c,d:Byte);                virtual;
  52.    end;
  53.    PFRPlaette=^TFRPlaette;
  54.    TFRPlaette=object(TObject)
  55.       Pals                                         :     AFRPlaette;
  56.     constructor Init;
  57.       procedure Copy;                                    virtual;
  58.       procedure Push;                                    virtual;
  59.       procedure ThisAt(a,b,c,d:Byte);                    virtual;
  60.       procedure ThatAt(var a,b,c,d:Byte);                virtual;
  61.       procedure Cycle;                                   virtual;
  62.    end;
  63.  
  64.  
  65.  
  66. implementation
  67. {TObject.TFRPal}
  68. constructor TFRPal.Init(n:Byte);
  69. begin
  70.    inherited Init;
  71.    Spot:=n;
  72. end;
  73. procedure   TFRPal.Copy;
  74. begin
  75.    Port[$3c7]:=Spot;
  76.    Red:=Port[$3c9];
  77.    Green:=Port[$3c9];
  78.    Blue:=Port[$3c9];
  79. end;
  80. procedure   TFRPal.Push;
  81. begin
  82.    Port[$3c8]:=Spot;
  83.    Port[$3c9]:=Red;
  84.    Port[$3c9]:=Green;
  85.    Port[$3c9]:=Blue;
  86. end;
  87. procedure   TFRPal.This(a,b,c:Byte);
  88. begin
  89.    Red:=a;
  90.    Green:=b;
  91.    Blue:=c;
  92.    Push;
  93. end;
  94. procedure   TFRPal.That(var a,b,c:Byte);
  95. begin
  96.    Copy;
  97.    a:=Red;
  98.    b:=Green;
  99.    c:=Blue;
  100. end;
  101. {TFRPal.TFRPla}
  102. constructor TFRPla.Init(n:Byte);
  103. begin
  104.    inherited Init(n);
  105.    cRed:=-1;
  106.    cGreen:=-1;
  107.    cBlue:=-1;
  108. end;
  109. procedure   TFRPla.Cycle;
  110. begin
  111.    if (cRed=-1) and (Red-1<FRCycBot)     then cRed:=-1*cRed;
  112.    if (cREd=1)  and (Red+1>FRCycTop)     then cRed:=-1*cRed;
  113.    if (cGreen=-1) and (Green-1<FRCycBot) then cGreen:=-1*cGreen;
  114.    if (cGreen=1) and (Green+1>FRCycTop)  then cGreen:=-1*cGreen;
  115.    if (cBlue=-1) and (Blue-1<FRCycBot)   then cBlue:=-1*cBlue;
  116.    if (cBlue=1) and (Blue+1>FRCycTop)    then cBlue:=-1*cBlue;
  117.    This(Red+1,Green+1,Blue+1);
  118. end;
  119.  
  120. {TObject.TFRPalette}
  121. constructor TFRPalette.Init;
  122. var
  123.    a:Byte;
  124. begin
  125.    inherited Init;
  126.    for a:=0 to 255 do
  127.       Pals[a].Init(a);
  128. end;
  129. procedure   TFRPalette.Copy;
  130. var
  131.    a:Byte;
  132. begin
  133.    for a:=0 to 255 do
  134.       Pals[a].Copy;
  135. end;
  136. procedure   TFRPalette.Push;
  137. var
  138.    a:Byte;
  139. begin
  140.    for a:=0 to 255 do
  141.       Pals[a].Push;
  142. end;
  143. procedure   TFRPalette.ThisAt(a,b,c,d:Byte);
  144. begin
  145.    Pals[a].This(b,c,d);
  146. end;
  147. procedure   TFRPalette.ThatAt(var a,b,c,d:Byte);
  148. begin
  149.    Pals[a].That(b,c,d);
  150. end;
  151. {TObject.TFRPlaette}
  152. constructor TFRPlaette.Init;
  153. var
  154.    a:Byte;
  155. begin
  156.    inherited Init;
  157.    for a:=0 to 255 do
  158.       Pals[a].Init(a);
  159. end;
  160. procedure   TFRPlaette.Copy;
  161. var
  162.    a:Byte;
  163. begin
  164.    for a:=0 to 255 do
  165.       Pals[a].Copy;
  166. end;
  167. procedure   TFRPlaette.Push;
  168. var
  169.    a:Byte;
  170. begin
  171.    for a:=0 to 255 do
  172.       Pals[a].Push;
  173. end;
  174. procedure   TFRPlaette.ThisAt(a,b,c,d:Byte);
  175. begin
  176.    Pals[a].This(b,c,d);
  177. end;
  178. procedure   TFRPlaette.ThatAt(var a,b,c,d:Byte);
  179. begin
  180.    Pals[a].That(b,c,d);
  181. end;
  182. procedure   TFRPlaette.Cycle;
  183. var
  184.    a:Byte;
  185. begin
  186.    for a:=0 to 255 do
  187.       Pals[a].Cycle;
  188. end;
  189.  
  190. end.